home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
crc16pas.zip
/
CRC16.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-10-10
|
4KB
|
187 lines
program CRC_16;
type
string80 = string[80];
bit_type = 0..1;
crc_type = array [1..16] of bit_type;
var
buffer : string80;
crc : crc_type;
function PowerOf2(n:byte):byte;
var
temp : byte;
begin
temp := 1;
while n > 0 do
begin
temp := temp * 2;
dec(n)
end;
PowerOf2 := temp
end;
function LPad(s:string; pad_char:char; pad_length:byte):string;
var
len,i : byte;
begin
len := length(s);
if len < pad_length then
for i := pad_length downto len+1 do
s := pad_char + s;
lpad := s
end;
procedure InitCRC(var crc:crc_type; bit:bit_type);
var i : byte;
begin
for i := 1 to 16 do
crc[i] := bit;
end;
function IntToHex(n:integer):string;
var
temp : string;
base : byte;
begin
temp := '';
while n > 0 do
begin
if n div 16 >= 0 then
begin
if n mod 16 > 9 then
base := 55
else
base := 48;
temp := chr(base + n mod 16) + temp;
end;
n := n div 16
end;
IntToHex := temp
end;
function CharToHex(ch:char):string;
begin
CharToHex := IntToHex(ord(ch))
end;
function BinToInt(bit_str:string):byte;
var
exponent,len,temp,i : byte;
begin
len := length(bit_str);
exponent := 0;
temp := 0;
for i:=len downto 1 do
begin
if bit_str[i] = '1' then
temp := temp + PowerOf2(exponent);
inc(exponent)
end;
BinToInt := temp
end;
function IntToBin(n:integer):string;
var
temp : string;
begin
temp := '';
while n > 0 do
begin
if n div 2 >= 0 then
temp := chr(48 + n mod 2) + temp;
n := n div 2
end;
IntToBin := LPad(temp,'0',8)
end;
function CharToBin(ch:char):string;
begin
CharToBin := IntToBin(ord(ch))
end;
procedure CalcCRC(var crc:crc_type; buffer:string80);
var
i,j,len1,len2 : byte;
bin_str : string[8];
procedure ShiftLeft(var crc:crc_type; in_bit_char:char);
var
temp_crc : crc_type;
in_bit : bit_type;
i : byte;
begin {ShiftLeft}
InitCRC(temp_crc,0);
in_bit := ord(in_bit_char) - 48;
for i := 16 downto 1 do
case i of
1,14 : temp_crc[i] := crc[1] xor crc[i+1];
2..13,15 : temp_crc[i] := crc[i+1];
16 : temp_crc[i] := crc[1] xor in_bit;
end; {case}
crc := temp_crc
end; {ShiftLeft}
begin {CalcCRC}
len1 := length(buffer);
for i := 1 to len1 do
begin
bin_str := CharToBin(buffer[i]);
len2 := length(bin_str);
for j := 1 to len2 do
ShiftLeft(crc,bin_str[j])
end;
for i := 1 to 16 do
ShiftLeft(crc,'0')
end;
procedure PrintCRC(crc:crc_type);
var
hi_byte,lo_byte : string[8];
i : byte;
begin
hi_byte := '';
lo_byte := '';
for i := 1 to 8 do
hi_byte := hi_byte + chr(48 + crc[i]);
for i := 9 to 16 do
lo_byte := lo_byte + chr(48 + crc[i]);
writeln('(D) ',BinToInt(hi_byte),':',BinToInt(lo_byte));
writeln('(B) ',hi_byte,':',lo_byte);
writeln('(H) ',IntToHex(BinToInt(hi_byte)),':',
IntToHex(BinToInt(lo_byte)));
end;
begin
writeln;
writeln('Enter text (blank line quits):');
writeln;
write('>');
readln(buffer);
writeln;
while length(buffer) > 0 do
begin
InitCRC(crc,0);
CalcCRC(crc,buffer);
PrintCRC(crc);
writeln;
write('>');
readln(buffer);
writeln
end;
writeln('Bye!')
end.